perm filename GAME.JMC[206,LSP]1 blob
sn#379040 filedate 1978-09-05 generic text, type T, neo UTF8
(DEFPROP GAME
(VALMAX
VALMIN
LINEMAX
LINEMIN
TREEMAX
TREEMIN
RECTIFY
COMMONTAIL
COMMONHEAD
TRYJMC)
FNS)
(DEFPROP VALMAX
(LAMBDA(U ALPHA BETA)
(COND ((NULL U) ALPHA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA))
(VALMAX (CDR U) ALPHA BETA))
((LESSP S BETA) (VALMAX (CDR U) S BETA))
(T BETA)))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
(T (VALMIN (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)
(DEFPROP VALMIN
(LAMBDA(U ALPHA BETA)
(COND ((NULL U) BETA)
(T
((LAMBDA(S)
(COND ((NOT (GREATERP S ALPHA)) ALPHA)
((LESSP S BETA) (VALMIN (CDR U) ALPHA S))
(T (VALMIN (CDR U) ALPHA BETA))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA) (IMVAL (CAR U)))
(T (VALMAX (SUCCESSORS (CAR U)) ALPHA BETA)))))))
EXPR)
(DEFPROP LINEMAX
(LAMBDA(U LINE ALPHA BETA)
(COND ((NULL U) (CONS ALPHA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA))
(LINEMAX (CDR U) LINE ALPHA BETA))
((LESSP (CAR S) BETA)
(LINEMAX (CDR U)
(CONS (EXT (CAR U)) (CDR S))
(CAR S)
BETA))
(T (CONS BETA LINE))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA)
(LIST (IMVAL (CAR U))))
(T
(LINEMIN (SUCCESSORS (CAR U))
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP LINEMIN
(LAMBDA(U LINE ALPHA BETA)
(COND ((NULL U) (CONS BETA LINE))
(T
((LAMBDA(S)
(COND ((NOT (GREATERP (CAR S) ALPHA)) (CONS ALPHA LINE))
((LESSP (CAR S) BETA)
(LINEMIN (CDR U)
(CONS (EXT (CAR U)) (CDR S))
ALPHA
(CAR S)))
(T (LINEMIN (CDR U) LINE ALPHA BETA))))
(COND ((TER (RECTIFY (CAR U)) ALPHA BETA)
(LIST (IMVAL (CAR U))))
(T
(LINEMAX (SUCCESSORS (CAR U))
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP TREEMAX
(LAMBDA(U TRMAX TRMIN ALPHA BETA)
(COND
((NULL U) (LIST ALPHA TRMAX TRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(TREEMAX (CDR U)
TRMAX
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
ALPHA
BETA))
((LESSP (CAR S) BETA)
(TREEMAX (CDR U)
(CONS (EXT (CAR U)) (CADR S))
(CONS (CONS (EXT (CAR U)) (CADDR S)) TRMIN)
(CAR S)
BETA))
(T (LIST BETA (CONS (EXT (CAR U)) (CADR S)) NIL))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
(T
(TREEMIN (SUCCESSORS (CAR U))
NIL
(CONS BETA (QUOTE BETA-CUTOFF))
ALPHA
BETA)))))))
EXPR)
(DEFPROP TREEMIN
(LAMBDA(U TRMAX TRMIN ALPHA BETA)
(COND
((NULL U) (LIST BETA TRMAX TRMIN))
(T
((LAMBDA(S)
(COND
((NOT (GREATERP (CAR S) ALPHA))
(LIST ALPHA NIL (CONS (EXT (CAR U)) (CADDR S))))
((LESSP (CAR S) BETA)
(TREEMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
(CONS (EXT (CAR U)) (CADDR S))
ALPHA
(CAR S)))
(T
(TREEMIN (CDR U)
(CONS (CONS (EXT (CAR U)) (CADR S)) TRMAX)
TRMIN
ALPHA
BETA))))
(COND
((TER (RECTIFY (CAR U)) ALPHA BETA)
((LAMBDA (V) (LIST V (LIST V) (LIST V))) (IMVAL (CAR U))))
(T
(TREEMAX (SUCCESSORS (CAR U))
(CONS ALPHA (QUOTE ALPHA-CUTOFF))
NIL
ALPHA
BETA)))))))
EXPR)
(DEFPROP RECTIFY
(LAMBDA(P)
(PROG (Z Q)
(SETQ Q (COMMONTAIL P P1))
L1 (COND ((EQUAL Q P1) (GO L2)))
(REVERT)
(GO L1)
L2 (SETQ Z (LISTSUBT P P1))
L3 (COND ((NULL Z) (RETURN P)))
(UPDATE (CAR Z))
(SETQ Z (CDR Z))
(GO L3)))
EXPR)
(DEFPROP COMMONTAIL
(LAMBDA (U V) (REVERSE (COMMONHEAD (REVERSE U) (REVERSE V))))
EXPR)
(DEFPROP COMMONHEAD
(LAMBDA(U V)
(COND ((OR (NULL U) (NULL V) (NOT (EQUAL (CAR U) (CAR V)))) NIL)
(T (CONS (CAR U) (COMMONHEAD (CDR U) (CDR V))))))
EXPR)
(DEFUN TRYJMC (MODE WW POS)
(PROG ()
(NEWGAME)
(SETQ W WW)
(MAPC (FUNCTION UPDATE) (REVERSE POS))
(PRINTBOARD)
(PRINT
(COND ((EQ MODE 'VAL)
(COND (W (VALMIN (SUCCESSORS P1) -1000 1000))
(T (VALMAX (SUCCESSORS P1) -1000 1000))))
((EQ MODE 'LINE)
(COND (W (LINEMIN (SUCCESSORS P1) NIL -1000 1000))
(T (LINEMAX (SUCCESSORS P1) NIL -1000 1000))))
((EQ MODE 'TREE)
(COND (W (TREEMIN (SUCCESSORS P1) NIL NIL -1000 1000))
(T (TREEMAX (SUCCESSORS P1) NIL NIL -1000 1000)))) )
) ))
(DEFPROP GAMEXX
(VMX LMX TMX)
FNS)
(DEFPROP VMX
(LAMBDA (P) (RECTIFY P) (COND (W (VALMIN (SUCCESSORS P) -1000 1000)) (T (VALMAX (SUCCESSORS P) -1000 1000))))
EXPR)
(DEFPROP LMX
(LAMBDA(P)
(RECTIFY P)
(COND (W (LINEMIN (SUCCESSORS P) NIL -1000 1000)) (T (LINEMAX (SUCCESSORS P) NIL -1000 1000))))
EXPR)
(DEFPROP TMX
(LAMBDA(P)
(RECTIFY P)
(COND (W (TREEMIN (SUCCESSORS P) NIL NIL -1000 1000)) (T (TREEMAX (SUCCESSORS P) NIL NIL -1000 1000))))
EXPR)